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-- BcdWrite.mesa; edited by Johnsson on August 30, 1978 9:07 PM 

DIRECTORY 

AUoDefs: FROM "altodefs", 

BcdControlDefs: FROM "bcdcontroldef s", 

BcdDefs: FROM "bcddefs". 

BcdErrorDefs: FROM "bcderrordef s'\ 

BcdFileDefs: FROM "bcdf iledefs", 

BcdHeapDefs: FROM "bcdheapdef s'\ 

BcdTabDefs: FROM "bcdtabdef s\ 

BcdTreeDefs: FROM "bcdtreedefs" , 

BcdUtilDefs: FROM "bcdutildef s\ 

IODefs: FROM "iodefs\ 

InlineDefs: FROM "inlinedef s", 

MiscDefs: FROM "miscdefs", 

SegmentDefs: FROM "segmentdefs", 

StreamDefs: FROM "streamdef s'\ 

StringDefs: FROM "stringdef s", 

SystemDefs: FROM "systemdef s" , 

SymbolCompressorDefs: FROM "symbolcompressordef s", 

TableDefs: FROM "tabledefs", 

TimeDefs: FROM "timedefs"; 

DEFINITIONS FROM BcdDefs; 

BcdWrite: PROGRAM [data: BcdControlDefs. BinderData] 

IMPORTS BcdErrorDefs, BcdFileDefs, BcdHeapDefs, BcdTabDefs, BcdTreeDefs, BcdUtilDefs, IODefs, MiscDef 
**s, SegmentDefs, StreamDefs, StringDefs, SystemDefs, SymbolCompressorDefs, TimeDefs, TableDefs 

EXPORTS BcdControlDefs « 

BEGIN 

Alignment: CARDINAL ■ 4; -- Code Segments must start at MOD Alignment 

StreamHandle: TYPE ■ StreamDefs. StreamHandle; 
FileSegmentHandle: TYPE * SegmentDefs. FileSegmentHandle; 
empty: BcdTreeDefs. TreeLink a BcdTreeDefs. empty; 

BcdWriteError: PUBLIC SIGNAL - CODE; 

error: PROCEDURE - BEGIN SIGNAL BcdWriteError END; 

tb, stb, ctb, mtb, etb, itb, sgb, ftb, ntb: TableDefs. TableBase; 
ssb: BcdDefs. NameString; 

Notifier: TableDefs. TableNotif ier • 
BEGIN 

tb «- base[treetype]; 
stb ♦- base[sttype]; 
ctb «- base[cttype]; 
mtb <- base[mttype]; 
etb <- base[exptypej; 
itb «- base[imptype]; 
sgb ♦- base[sgtype]; 
ftb «- base[fttype]; 
ntb «- base[nttype]; 
ssb <- LOOPHOLE[base[sstype]]; 
IF bed # NIL THEN 

BEGIN 

bed. ctb <- ctb; 

bed. mtb «~ mtb; 

IF ~packing THEN bed. sgb *- sgb; 

END; 
RETURN 
END; 

bed: POINTER TO BcdUtilDefs .BcdBases «- NIL; 
header: POINTER TO BcdDefs. BCD; 

WriteBcd: PUBLIC PROCEDURE [root: BcdTreeDefs .TreeLink] - 
BEGIN 

TableDefs.AddNotify[Notifier]; 
WITH r: root SELECT FROM 
subtree ■> 
BEGIN 

packing «- (tb+r. index) .son2 # BcdTreeDefs .empty AND data.copycode; 
Initial i*e[]; 
IF packing THEN 
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BEGIN 

MakePackItem[(tb+r. index) .son2]; 
Fi11InSgMap[]; 
END; 
CopyConf1gs[]; 
CopyModules[]; 

WITH config: (tb+r. index) ,son3 SELECT FROM 
subtree ■> 

BEGIN OPEN c: tb+config. index; 
BcdTreeDefs.scan1ist[c.sonl, Copy Import]; 
BcdTreeDefs.scan1ist[c.son2, CopyExport]; 
END; 
ENDCASE; 
END; 
ENDCASE; 
TableOut[j; 
Finalize[]; 

Tab1eDefs.DropNotify[Notifier]; 
RETURN 
END; 



Initialize: PROCEDURE - 

BEGIN OPEN InlineDefs, TableDefs; 
impbase, expbase, sgbase, fbase, nba 
impsize, expsize, sgsize, fsize, nsi 
nsgis: CARDINAL; 

d: CARDINAL «- SIZE[BcdUtilDef s .BcdBa 
p: POINTER; 

IF data.copycode OR data.copysymbols 
[impbase, impsize] <- Tab1eBounds[imp 
[expbase, expsize] «- Tab1eBounds[exp 
[sgbase, sgsize] <- Tab1eBounds[sgtyp 
nsgis <- sgsize/SIZE[SGRecord]; 
IF "packing THEN sgsize <- 0; 
[fbase, fsize] <- TableBounds[f ttype] 
[nbase, nsize] «- TableBounds[nttype] 
[ssbase, sssize] ♦- TableBounds[sstyp 
bed 4- p 4- 

BcdHeapDef s.GetSpace[d+impsize+exp 
header <- p+SIZE[BcdUti!Def s.BcdBases 
In itHeader[ header]; 
d <- LOOPHOLE[p+d]; 
C0PY[to: LOOPHOLE[bcd.etb 

d H + expsize; 

TrimTab1e[exptype,0]; 
COPY[to: LOOPHOLE[bcd.itb 

d <- d + impsize; 

TrimTabl e[ imp type, 0]; 
COPY[to: LOOPHOLE[bcd.ftb 

d *■ d + fsize; 

TrimTable[fttype,0]; 
C0PY[to: LOOPHOLE[bcd.ntb 

d <- d + nsize; 

TrimTab1e[nttype,0]; 
C0PY[to: bcd.ssb *- LOOPHOLE[d], from 

d <- d + sssize; 

BcdTabDefs.BcdTabReset[]; 
IF packing THEN 

BEGIN 

C0PY[to: LOOPHOLE[bcd.sgb *- d], fr 
d ♦- d + sgsize; 
TrimTable[sgtype,0]; 

END; 
bcd.ctb <- Tab1eBounds[cttype].base; 
bcd.mtb <- TableBounds[mttype].base; 
IF data.copycode OR data.copysymbols 

BEGIN MapCodeSymbolFiles[]; InitCo 
IF packing THEN InitSgMap[nsgis] 
ELSE 

BEGIN 

bcd.sgb «- Tab1eBounds[sgtype].base 

IF ~data. copycode THEN MapSegments 

IF ~data. copysymbols THEN MapSegme 

END; 
END; 



se t ssbase: TableBase; 
ze, sssize: CARDINAL; 

ses]+SIZE[BCD]; 

THEN InitCodeSymbo1Copy[]; 
type]; 
type]; 
e]; 



e]; 
size+sgsize+fsize+nsize+sssize]; 

3; 



d], from: LOOPHOLE[expbase], nwords: expsize]; 



d], from: L00PHOLE[impbase], nwords: impsize]; 



d], from: LOOPHOLE[fbase], nwords: fsize]; 



d], from: LOOPHOLE[nbase], nwords: nsize]; 



LOOPHOLE[ssbase] , nwords: sssize]; 



om: LOOPHOLE[sgbase], nwords: sgsize]; 



THEN 
pyMap[nsgis]; END; 



[code]; 
nts[symbols]; 
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Finalize: PROCEDURE ■ 
BEGIN 

ReleaseCodeSymbolCopy[]; 
BcdHeapDef s.FreeSpace[bcd]; 
bed ♦■ NIL; 
FreeSgMap[]; 
FreeCopyMap[]; 
FreePackItems[]; 
END; 

InitHeader: PROCEDURE [header: POINTER TO BCD] ■ 
BEGIN 

MiscDefs.Zero[header, SIZE[BCD]]; 
header. versionident «- BcdDefs.VersionID; 
header. version <- [time: TimeDefs.CurrentDayTime[], zapped: FALSE, 

net: data. network, host: data. host]; 
header. creator <- data.binderVersion; 
header. definitions «- FALSE; 
header. source «- BcdDefs.NullName; 
RETURN 
END; 

Map: TYPE « RECORD [ 
fti: FTIndex, 
type: SegClass, 
filename: STRING, 
f ilehandle: SegmentDef s . FileHandle]; 

codemap, symbolmap: POINTER TO Map; 

InitCodeSymbolCopy: PROCEDURE - 
BEGIN OPEN BcdFileDefs; 
setup: PROCEDURE [file: STRING, type: SegClass] 

RETURNS [p: POINTER TO Map] - 

BEGIN 

p «- BcdHeapDefs.GetSpace[SIZE[Map]]; 

p. type <- type; 

p. filename <- file; 

p.filehandle «- NIL; 

IF file. length ■ THEN p. fti 4- FTSelf 

ELSE p. fti «- BcdUtilDefs.EnterFile[file]; 

END; 
IF data.copycode THEN 

codemap <- setup[data.codef ile.code]; 
IF data.copysymbols THEN 

symbolmap «- setup[data.symbolf ile, symbols]; 
LookupFileTable[]; 
IF data.copycode AND codemap. fti # FTSelf THEN 

codemap. f ilehandle «- HandleForFile[ 

codemap. fti I UnknownFile -> CONTINUE]; 
IF data.copysymbols AND symbolmap. fti # FTSelf THEN 

symbolmap. f ilehandle *- HandleForFile[ 

symbolmap. fti 1 UnknownFile -> CONTINUE]; 
END; 

MapCodeSymbolFiles: PROCEDURE ■ 
BEGIN 
IF data.copycode THEN 

codemap. fti *- BcdUtilDef s.MergeFile[bcd, codemap. fti]; 
IF data.copysymbols THEN 

symbolmap. fti «- BcdUtilDef s .MergeFile[bcd, symbolmap. fti]; 
END; 

ReleaseCodeSymbolCopy: PROCEDURE - 
BEGIN 
IF data.copycode THEN 

BcdHeapDef s.FreeSpace[ codemap]; 
IF data.copysymbols THEN 

BcdHeapDef s. FreeSp ace [symbol map]; 
codemap <- symbolmap «- NIL; 
END; 

BumpVersion: PROCEDURE [v: VersionStamp, n: CARDINAL] RETURNS [VersionStamp] 
BEGIN 

old: CARDINAL - v. time. lowbits; 
IF (v. time. lowbits <- v. time. lowbits + n) < old THEN 
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v.time.hlghbits <- v.time.highbits + 1; 
RETURN[v] 
END; 

EnumerateSegments: PROCEDURE [proc: PROCEDURE[SGIndex]] ■ 
BEGIN OPEN TableDefs; 
sgi: SGIndex; 

sgLimit: SGIndex ■ LOOPHOLE[TableBounds[sgtype].size]; 
FOR sgi <- FIRST[SGIndex], sgi + SIZE[SGRecord] UNTIL sgi ■ sgLimit DO 

proc[sgi]; 

ENDLOOP; 
RETURN 
END; 

EnumerateOldSegments: PROCEDURE [proc: PROCEDURE[SGIndex]] ■ 
BEGIN OPEN TableDefs; 
sgi, sgLimit: SGIndex; 

IF -packing THEN BEGIN EnumerateSegments[proc]; RETURN END; 
sgLimit «- LOOPHOLE[LENGTH[sgMap]*SIZE[SGRecord]]; 
FOR sgi 4- FIRST[SGIndex] t sgi + SIZE[SGRecord] UNTIL sgi ■ sgLimit DO 

proc[sgi]; 

ENDLOOP; 
RETURN 
END; 

InitFile: PROCEDURE [p: POINTER TO Map] 

RETURNS [s: StreamHandle, page: CARDINAL] - 
BEGIN OPEN SegmentDefs, StreamDefs; 
In: BcdDefs.BCD; 
BcdUtilDefs.SetFileVersion[p.fti, 

BumpVersion[header .version, IF p. type ■ code THEN 1 ELSE 2]]; 
InitHeader[@lh]; 

In. version <- (ftb+p.fti) .version; 
IF p.filehandle » NIL THEN 

BEGIN 

p.filehandle «- NewFile[p.f ilename,Write+Append,Defaul tVersion]; 

END; 
s «- CreateWordStream[p.f ilehandle.Write+Append]; 
[] «- WriteBlock[s,@lh,SIZE[BcdDefs.BCD]]; 

page «- l+(SIZE[BcdDef s.BCD]+Al toDefs .PageSize-l)/Al toDef s.PageSize; 
RETURN 
END; 

-- Code Packing 

packing: BOOLEAN; 

Packltem: TYPE ■ RECORD [ 
link: PackHandle, 

newsgi: SGIndex, -- in the new table 
count: CARDINAL, 
item: ARRAY [0..0) OF MTIndex]; 

PackHandle: TYPE - POINTER TO Packltem; 

phHead, phTail: PackHandle <- NIL; 

MakePackltem: BcdTreeDef s.TreeScan ■ 

-- t is empty, a list of ids, or a list of lists of ids 
BEGIN OPEN BcdTreeDefs; 
ph: PackHandle; 
px: TreeXIndex; 
i, nsons: CARDINAL; 
IF t ■ empty THEN RETURN; 
WITH t SELECT FROM 
subtree -> 

BEGIN OPEN tt: tb+index; 

IF tt.name # list THEN error[]; 

IF tt.sonl.tag ■ subtree THEN 

BEGIN scan! ist[t, MakePackltem]; RETURN END; 
px «- LOOPHOLE[index, TreeXIndex]+TreeNodeSize; 
END; 
ENDCASE; 
nsons <- 1 istlength[t]; 

ph <- BcdHeapDefs.GetSpace[SIZE[PackItem]+nsons]; 
pht 4- [link: NIL, 
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newsgi: Tab1eDefs.Allocate[sgtype, SIZE[SGRecord]], 
count: nsons, item:]; 
(sgb+ph.newsgi)t <- [class: code, file: codemap.ftl , 

base:0, pages:0, extraPages:0]; 
MiscDefs.SetBlock[@ph.item[0], MTNull , nsons]; 
FOR i IN [0.. nsons) DO 

WITH (tb+px+i).soni SELECT FROM 
symbol ■> 

WITH (stb+index) SELECT FROM 
external ■> 

WITH m: map SELECT FROM 
module ■> 
BEGIN 

ph.item[i] <- m.mtl ; 

SetSgMap[old: (mtb+m. mti) .code.sgi , new: ph. newsgi]; 
END; 
ENDCASE; 
ENDCASE; 
ENDCASE; 
ENDLOOP; 
IF phTail ■ NIL THEN phHead <- phTail ♦- ph 
ELSE BEGIN phTail. link ♦■ ph; phTail «- ph END; 
RETURN 
END; 

FreePackltems: PROCEDURE ■ 
BEGIN 

p, next: PackHandle; 
FOR p <- phHead, next UNTIL p - NIL DO 

next «- p. link; 

BcdHeapDef s . FreeSpace[p] ; 

ENDLOOP; 
phHead <- phTail <- NIL; 
RETURN 
END; 

PackCodeSegments: PROCEDURE [out: StreamHandle, startpage: CARDINAL] 
RETURNS [nextpage: CARDINAL] - 
BEGIN 

pi: CARDINAL; 
ph: PackHandle; 

offset, validlength: CARDINAL; 
oldsgi: SGIndex; 
mti: MTIndex; 
seg: FileSegmentHandle; 

FixUp: PROCEDURE [mti: MTIndex] RETURNS [BOOLEAN] - 
BEGIN OPEN m: mtb+mti; 
length: CARDINAL; 
IF m. code.sgi ■ oldsgi THEN 
BEGIN 

length «- m.code.of f set+m. code. length/2; 
m. code. offset *- m.code.offset+offset; 
m. code. packed <- TRUE; 

IF length > validlength THEN validlength <- length; 
END; 
RETURN[FALSE] 
END; 
nextpage «- startpage; 

FOR ph <- phHead, ph. link UNTIL ph ■ NIL DO 
StreamDef s.SetIndex[out,[page:nextpage-l,byte:0]]; 
offset <- 0; 

(sgb+ph. newsgi) .base <- nextpage; 
FOR pi IN [0. .ph. count) DO 

BEGIN OPEN SegmentDefs, module: mtb+mti; 
mti <- ph. item[pi]; 

IF module. links - code AND -module. code. 1 inkspace THEN 
BEGIN 

offset <- AddLinksToCodeSegment[out, mti .offset, TRUE] + offset; 
GOTO ignore 
END; 
oldsgi <- module. code. sgi ; 

IF (seg<-SegmentForSgi[oldsgi]) - NIL THEN GOTO ignore; 
Swapln[seg]; 

IF offset MOD Alignment # THEN 
BEGIN 
i: CARDINAL; 
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FOR 1 IN [offset MOD Al ignment. .Al ignment) DO 
out.put[out t 0]; offset «- offset + 1 ENDLOOP; 
END; 
validlength <- 0; EnumerateModules[FixUp]; 

[] <- StreamDefs.WriteBlock[out, FileSegmentAddress[seg],valid1ength] ; 
offset «- offset + validlength; 
Unlock[seg]; DeleteFileSegment[seg]; 
EXITS ignore ■> NULL; 
END; 

ENDLOOP; 
nextpage <- ((sgb+ph.newsgi) .pages<-SystemDefs.PagesForWords[offset]) + nextpage; 
ENDLOOP; 
RETURN 
END; 

-- Segment Mapping 

sgMap: DESCRIPTOR FOR ARRAY OF SGIndex; 
copyMap: DESCRIPTOR FOR ARRAY OF BOOLEAN; 

InitCopyMap: PROCEDURE [nsgis: CARDINAL] - 
BEGIN 

copyMap «- DESCRIPTOR[BcdHeapDef s.GetSpace[nsgis], nsgis]; 
Mi scDefs.SetBlock[BASE[copyMap], FALSE, nsgis]; 
END; 

FreeCopyMap: PROCEDURE ■ 
BEGIN 
IF data.copycode OR data.copysymbols THEN 

BcdHeapDefs.FreeSpace[BASE[ copyMap]]; 
RETURN 
END; 

Copied: PROCEDURE [sgi: SGIndex] RETURNS [BOOLEAN] - 
BEGIN 

i: CARDINAL - LOOPHOLE[sgi ,CARDINAL]/SIZE[SGRecord]; 
RETURN[copyMap[i]] 
END; 

SetCopied: PROCEDURE [sgi: SGIndex] » 
BEGIN 

i: CARDINAL - LOOPHOLE[sgi , CARDINAL]/SIZE[SGRecord]; 
copyMap[i] «- TRUE; 
RETURN 
END; 

InitSgMap: PROCEDURE [nsgis: CARDINAL] - 
BEGIN 

sgMap <- DESCRIPTOR[BcdHeapDefs.GetSpace[nsgis], nsgis]; 
Mi scDefs.SetBlock[BASE[ sgMap] .SGNull , nsgis]; 
END; 

FreeSgMap: PROCEDURE - 
BEGIN 

IF packing THEN BcdHeapDef s . FreeSpace[BASE[sgMap]]; 
RETURN 
END; 

SetSgMap: PROCEDURE [old, new: SGIndex] - 
BEGIN 

i: CARDINAL - LOOPHOLE[ol d, CARDINAL]/SIZE[SGRecord] ; 
IF packing AND old # SGNull THEN sgMap[i] *- new; 
RETURN 
END; 

ReadSgMap: PROCEDURE [old: SGIndex] RETURNS [SGIndex] - 
BEGIN 

i: CARDINAL - LOOPHOLE[old ,CARDINAL]/SIZE[SGRecord] ; 
RETURN[IF -packing OR old - SGNull THEN old ELSE sgMap[i]] 
END; 

FilllnSgMap: PROCEDURE - 

BEGIN — called only when packing ■> copycode ■ TRUE 

i: CARDINAL; 

oldsgi, newsgi: SGIndex; 

FOR i IN [O..LENGTH[sgMap]) DO 
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IF sgMap[1] ■ SGNull THEN 
BEGIN 

oldsgi «- LOOPHOLE[i*SIZE[SGRecord]]; 
newsgi «- TableDefs.Allocate[sgtype, SIZE[SGRecord]]; 
(sgb+newsgi)+ «- (bcd.sgb+oldsgi)t; 
(sgb+newsgi) .file «- 

(IF (sgb+newsgi) .class ■ symbols THEN 
(IF data.copysymbols THEN symbolmap. f t1 
ELSE BcdUtilDefs.MergeFile[bcd, (sgb+newsgi) .file]) 
ELSE codemap.fti); 
sgMap[i] ♦- newsgi; 
END; 
ENDLOOP; 
RETURN 
END; 

FixAllSgis: PROCEDURE - 

BEGIN -- replace all sgis with ReadSgMap[sgi] 
FixOne: PROCEDURE [mti: MTIndex] RETURNS [BOOLEAN] ■ 

BEGIN OPEN m: mtb+mti; 

m.code.sgi «- ReadSgMap[m.code.sgi]; 

m.sseg «- ReadSgMap[m.sseg]; 

RETURN[FALSE] 

END; 
Enume r a teModules[ FixOne]; 
RETURN 
END; 

SegmentForSgi: PROCEDURE [sgi: SGIndex] RETURNS [s: FileSegmentHandle] 
BEGIN OPEN SegmentDefs, seg: bcd.sgb+sgi; 
s «- NIL; 

IF Copied[sgi] OR seg. file » FTNull THEN RETURN; 
s <- NewFileSegment[ 

BcdF i 1 eDef s. Hand leForFile[ seg. file 
1 BcdFileDefs.UnknownFile ■ > CONTINUE], 
seg. base, seg. pages+seg. ex traPages, Read]; 
IF s ■ NIL THEN 
BEGIN 

BcdErrorDef s.ErrorNameBase[ 
error, "cannot be opened"L, 
( bed. ftb+seg. file) .name, bcd.ssb]; 
header. versionident «- 0; 
END; 
SetCopied[sgi]; 
RETURN 
END; 

-- Code Links 

AddLinksToCodeSegment: PROCEDURE 

[out: StreamHandle, mti: MTIndex, offset: CARDINAL, packed: BOOLEAN] 
RETURNS [CARDINAL] - 
BEGIN OPEN SegmentDefs; 
sgi: SGIndex *- (mtb+mti) .code. sgi ; 
codelength: CARDINAL «- (mtb+mti) . code, length/2; 
i, linkspace: CARDINAL; 
s: FileSegmentHandle; 
prefixwords: CARDINAL *- 0; 

FixOffset: PROCEDURE [mti: MTIndex] RETURNS[BOOLEAN] ■ 
BEGIN OPEN c: (mtb+mti) .code; 
IF c.sgi - sgi THEN 
BEGIN 

c. linkspace «- TRUE; 
c. offset <- c.offset+offset; 
c. packed «- packed; 
END; 
RETURN[FALSE] 
END; 
IF (s<-SegmentForSgi[sgi]) - NIL THEN RETURN[0]; 
linkspace «- (mtb+mti) .frame . length; 
IF offset - AND linkspace # THEN 
BEGIN 

prefixwords *- 1; 

out.put[out, linkspace + Alignment - (linkspace MOD Alignment)]; 
offset «- offset+1; 
END; 
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IF (offset+linkspace) MOD Alignment # THEN 

linkspace <- linkspace + Alignment - ((offset+linkspace) MOD Alignment); 
offset +• offset+linkspace; 
EnumerateModules[FixOffset]; 

FOR i IN [0.. linkspace) DO out.put[out,0] ENDLOOP; 
Swapln[s] ; 

[] <- StreamD8fs.WriteBlock[out,FileSegmentAddress[s] t codelength]; 
Unlock[s] ; DeleteFileSegment[sj; 
RETURN[pref ixwords+1 inkspace+codelength] 
END; 

MoveCodeSegments: PROCEDURE ■ 
BEGIN 

out: StreamHandle; 
nextpage: CARDINAL; 

AddLinks: PROCEDURE [mti: MTIndex] RETURNS [BOOLEAN] - 
BEGIN OPEN m: mtb+mti; 
nwords, npages: CARDINAL; 
newsgi: SGIndex; 

IF m. links ■ code AND ~m.code. 1 inkspace THEN 
BEGIN 

St reamDef s.SetIndex[out, [page: next page- 1, by te:0]]; 
nwords «- AddLinksToCodeSegment[out, mti, 0, FALSE]; 
npages «- SystemDef s .PagesForWords[nwords]; 
newsgi «- ReadSgMap[m.code.sgi]; 
(sgb+newsgi) .f ile <- codemap.fti; 
(sgb+newsgi) .base <- nextpage; 
(sgb+newsgi) .pages «- npages; 
nextpage <- nextpage + npages; 
END; 
RETURN[FALSE] 
END; 
MoveOne: PROCEDURE [oldsgi: SGIndex] ■ 

BEGIN OPEN SegmentDefs, seg: bcd.sgb+oldsgi ; 
s: FileSegmentHandle; 
newsgi: SGIndex; 

IF seg. class ■ code AND (s<-SegmentForSgi[oldsgi]) # NIL THEN 
BEGIN 

newsgi <- ReadSgMap[oldsgi]; 
(sgb+newsgi) .file ♦- codemap.fti; 
(sgb+newsgi) .base <- nextpage; 
Swapln[s]; 

St reamDef s. Set Index[out, [page: nextpage-1, byte: 0]]; 
[] <- StreamDefs.WriteBlock[out t 

FileSegment Address [s] , s. pages *A1 toDef s.PageSize]; 
nextpage <- nextpage + s. pages; 
Unlock[s]; DeleteFileSegment[s]; 
END; 
RETURN 
END; 
IF codemap.fti = FTSelf THEN 

BEGIN out «- bcdStream; nextpage ♦■ nextBcdPage END 
ELSE [out, nextpage] «- InitFile[codemap]; 
nextpage *■ PackCodeSegments[out, nextpage]; 
En ume r a teModules[ AddLinks]; 
EnumerateOldSegments [MoveOne]; 

IF codemap.fti ■ FTSelf THEN nextBcdPage <- nextpage 
ELSE out.destroy[out]; 
RETURN 
END; 

MoveSymbolSegments: PROCEDURE - 
BEGIN 

out: StreamHandle; 
nextpage: CARDINAL; 
MoveOne: PROCEDURE [oldsgi: SGIndex] ■ 

BEGIN OPEN SegmentDefs, seg: bcd.sgb+oldsgi; 
s: FileSegmentHandle; 
newsgi: SGIndex; 

IF seg. class ■ symbols AND ($<-SegmentForSgi[oldsgi]) § NIL THEN 
BEGIN 

newsgi <- ReadSgMap[oldsgi]; 
(sgb+newsgi) .file «- symbolmap.f ti ; 
(sgb+newsgi) .base «- nextpage; 

StreamDefs . SetIndex[out , [page: next page- 1 , byte: 0]]; 
IF data. compress THEN 
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BEGIN 

s. pages «- (sgb+newsgi) .pages; 
(sgb+newsgi). extraPages <- 0; 

(sgb+newsgi) .pages <- CompressModule[oldsgi , s, out]; 
nextpage «- nextpage + (sgb+newsgi) .pages; 
END 
ELSE 
BEGIN 
Swapln[s]; 
[] ♦■ StreamDefs.WriteBlock[out, 

Fi leSegme nt Ad dress[s],s.p ages *AltoDefs. PageS ize]; 
nextpage +- nextpage + s. pages; 
Unlock[s]; DeleteFileSegment[s]; 
END; 
END; 
RETURN 
END; 
IF symbolmap.fti - FTSelf THEN 

BEGIN out «- bcdStream; nextpage <- nextBcdPage END 
ELSE [out, nextpage] «- InitFile[symbolmap]; 
Enumerate01dSegments[Move0ne]; 

IF symbolmap.fti ■ FTSelf THEN nextBcdPage <- nextpage 
ELSE out.destroy[out]; 
RETURN 
END; 

CompressModule: PROCEDURE [sgi: SGIndex, seg: FileSegmentHandle, stream: StreamHandle] 
RETURNS [pages: CARDINAL] - 
BEGIN OPEN StringDefs; 
smti: MTIndex; 
n: NameRecord; 
mname: STRING; 
ss: SubStringDescriptor; 
Find: PROCEDURE [mti: MTIndex] RETURNS[BOOLEAN] - 

BEGIN 

IF (mtb+mti).sseg ■ sgi THEN BEGIN smti <- mti; RETURN[TRUE] END; 

RETURN[FALSE] 

END; 
EnumerateModules[Find]; 
n ♦• (mtb+smti) .name; 

mname *- BcdHeapDef s.GetString[ssb.size[n]]; 
ss «- [base: @ssb. string, offset: n, length: ssb.size[n]]; 
AppendSubString[mname,@ss]; 

pages <- SymbolCompressorDef s.CompressSymbols[mname, seg, stream]; 
BcdHeapDef s. FreeString[mname]; 
RETURN 
END; 

CopyName: PROCEDURE [olditem, newitem: Namee] ■ 
BEGIN OPEN TableDefs; 
nti, newnti; NTIndex; 

newnti *- Allocate[nttype, SIZE[NTRecord]]; 
FOR nti ♦- FIRST[NTIndex], nti+SIZE[NTRecord] DO 
OPEN old: bcd.ntb+nti; 
IF old. item - olditem THEN 
BEGIN OPEN new: ntb+newnti; 
new. item 4- newitem; 

new. name «- BcdUtilDefs.MapName[bcd, old. name]; 
RETURN; 
END; 
ENDLOOP; 
END; 

CopyConfigs: PROCEDURE - 
BEGIN OPEN TableDefs; 

-- configs are already copied, only map names and files 
cti: CTIndex; 

ctLimit: CTIndex ■ LOOPHOLE[TableBounds[cttype]. size]; 
FOR cti 4- FIRST[CTIndex], cti+SIZE[CTRecord] UNTIL cti - ctLimit DO 

OPEN c: ctb+cti; 

header. nConfigs <- header. nConfigs + 1; 

c.name «- BcdUtilDefs.MapName[bcd, c.name]; 

c.file <- BcdUtilDefs.MergeFile[bcd, c.file]; 

IF c.namedinstance THEN CopyName[[conf ig[cti]], [conf ig[cti]]]; 

ENDLOOP; 
RETURN 
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END; 

EnumerateModules: PROCEDURE [p: PROCEDURE[MTIndex] RETURNS[BOOLEAN]] ■ 
BEGIN OPEN TableDefs; 
mti: MTIndex; 

mtLimit: MTIndex ■ LOOPHOLE[TableBounds[mttype] .size]; 
FOR mti «- FIRST[MTIndex], mti+SIZE[MTRecord]+(mtb+mti) .frame, length 

UNTIL mti ■ mtLimit DO 

IF p[mti] THEN EXIT; 

ENDLOOP; 
RETURN 
END; 

CopyModules: PROCEDURE ■ 
BEGIN OPEN TableDefs; 

-- modules are already copied, only map names and files 
MapOne: PROCEDURE[mti : MTIndex] RETURNS[BOOLEAN] - 

BEGIN OPEN m: mtb+mti; 

header. nModules «- header. nModules + 1; 

m.name <- BcdUtilDefs.MapName[bcd, m.name]; 

m.file ♦■ BcdUtilDefs.MergeFile[bcd, m.file]; 

IF m.namedinstance THEN CopyName[[module[mti]], [module[mti]]]; 

RETURN[FALSE] 

END; 
EnumerateModules [MapOne]; 
RETURN 
END; 

MapSegments: PROCEDURE[type: SegClass] ■ 
BEGIN 
CopySegment: PROCEDURE [sgi: SGIndex] ■ 

BEGIN OPEN s: sgb+sgi; 

IF s. class ■ type THEN 

s.file «- BcdUtilDefs.MergeFile[bcd, s.file]; 

RETURN 

END; 
EnumerateSegments[CopySegment] ; 
RETURN 
END; 

Copylmport: BcdTreeDef s.TreeScan ■ 
BEGIN OPEN BcdTabDefs; 
sti: STIndex <- STNull; 
olditi, iti: IMPIndex; 
name: HTIndex «- HTNull; 
WITH t SELECT FROM 

symbol -> BEGIN sti *- index; olditi «- (stb+sti) . impi END; 
subtree -> 

IF (tb+index) .name ■ item THEN 
BEGIN 

WITH si: (tb+index). sonl SELECT FROM 
symbol ■> 

BEGIN OPEN s: (stb+sl. index) ; 
--name <- s.hti; 
sti «- si. index; 
olditi «- s.impi; 
END; 
ENDCASE; 
IF (tb+index). son2 # empty THEN WITH s2: (tb+index) .son2 SELECT FROM 
symbol «> 

BEGIN OPEN s: (stb+s2 . index) ; 
sti «- s2. index; 
olditi <- s. impi; 
END; 
ENDCASE; 
END; 
ENDCASE -> error[]; 
IF sti - STNull OR olditi - IMPNull THEN RETURN; 
iti «- BcdUtilDef s.EnterImport[bcd, olditi, name]; 
(itb+iti).file ♦• BcdUtilDef s .MergeFile[bcd , ( itb+iti) . f ile]; 
IF header. firstdummy - THEN header .firstdummy <- (itb+iti) .gfi ; 
IF name - HTNull AND (itb+iti ) .namedinstance THEN 

CopyName[olditem: [import[olditi]] , newitem: [import[iti]]]; 
header, nlmports +- header. nlmports + 1; 
header. nDummies «- header. nDummies + (itb+iti) .ngfi ; 
RETURN 
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END; 

CopyExport: BcdTreeDef s.TreeScan ■ 
BEGIN OPEN BcdTabDefs; 
sti: STIndex <- STNull ; 
neweti: EXPIndex; 
oldeti: EXPIndex ♦• EXPNull; 
name: HTIndex *- HTNull; 
WITH t SELECT FROM 
symbol ■> sti <- index; 
subtree ■> 

IF (tb+index).name ■ Item THEN 
BEGIN 

WITH sl:(tb+index).sonl SELECT FROM 
symbol ■> 
BEGIN 

--name <- (stb+sl. index). hti ; 
sti «- si. index; 

IF (tb+1ndex).son2 # empty THEN WITH s:stb+sl . index SELECT FROM 
external ■> 

WITH m:s.map SELECT FROM 

interface ■> oldeti «- m.expi; 
ENDCASE -> error[]; 
ENDCASE ■> error[]; 
END; 
ENDCASE -> error[]; 
IF (tb+index).son2 # empty THEN WITH s2: (tb+index) .son2 SELECT FROM 
symbol ■> sti «- s2. index; 
ENDCASE -> error[]; 
END; 
ENDCASE «> error[]; 
WITH s:stb+sti SELECT FROM 
external »> 

WITH m:s.map SELECT FROM 
interface -> 

BEGIN OPEN new: etb+neweti; 

IF oldeti » EXPNull THEN oldeti «- m.expi; 

neweti «- BcdUtilDefs.EnterExport[bcd, oldeti, name]; 

InlineDefs.COPY[ 

from: @(bcd.etb+oldeti). 1 inks, 
to: ©new. links, 
nwords: new. size]; 
new. file <- BcdUtilDefs.MergeFile[bcd , new. file]; 
IF name - HTNull AND new.namedinstance THEN 

CopyName[olditem: [export[oldeti]] , newitem: [export[neweti]]]; 
END; 
module ■> [] ♦- NewExportForModule[m.mti , name]; 
ENDCASE »> RETURN; 
ENDCASE *> RETURN; 
header. nExports ♦- header. nExports + 1; 
RETURN 
END; 

NewExportForModule: PROCEDURE [mti: MTIndex, name: BcdTabDefs. HTIndex] RETURNS [eti: EXPIndex] 
BEGIN OPEN TableDefs, BcdTabDefs; 
nti: NTIndex; 

eti <- Allocate[exptype, SIZE[EXPRecord]+l] ; 
(etb+eti)t ♦- [ 

name: (mtb+mti) .name, 

size: 1, 

port: module, 

namedinstance: name # HTNull, 

file: (mtb+mti).file, 

links: ]; 
(etb+eti) .1 inks[0] <- [procedure[gf i : (mtb+mti) . gf i , ep: 0, tag: frame]]; 
IF name # HTNull THEN 

BEGIN 

nti <- Allocate[nttype,SIZE[NTRecord]]; 

(ntb+nti)t *- [ 

name: BcdUtilDef s.NameForHti[name], 
item: [module[mti]]]; 

END; 
RETURN 
END; 
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-- Bed Output Routines 

bcdStream: StreamHandle; 
nextBcdPage: CARDINAL; 

WriteBcdWords: PROCEDURE [addr: POINTER, n: CARDINAL] ■ 
BEGIN OPEN StreamDefs; 
[] ♦- WriteB"Iock[bcdStream, addr, n]; 
RETURN 
END; 

WriteSubTable: PROCEDURE [table: TableDefs. TableSelector] ■ 
BEGIN OPEN TableDefs; 
base: TableBase; 
size: CARDINAL; 

[base, size] <- TableBounds[table]; 
WriteBcdWords[LOOPHOLE[base], size]; 
RETURN 
END; 

TableOut: PROCEDURE ■ 
BEGIN OPEN TableDefs; 
d, s: CARDINAL; 
savenextpage: CARDINAL; 
OpenOutputFile[]; 
BEGIN OPEN header; 

IF firstdummy ■ THEN firstdummy «- BcdUtilDefs.GetGf i[0]; 

d <- SIZE[BCD]; 

ssOffset «- d; d «- d + (ssLimit «- TableBounds[sstype]. size) ; 

ctOffset <- d; d «- d + (s «- TableBounds[cttype] .size) ; 

ctLimit «- LOOPHOLE[s, CTIndex]; 

mtOffset «- d; d «- d + (s «- TableBounds[mttype]. size) ; 

mtLimit «- LOOPHOLE[s, MTIndex]; 

impOffset <- d; d «- d + (s «- TableBounds[imptype].size) ; 

impLimit «- LOOPHOLE[s, IMPIndex]; 

expOffset «- d; d <- d + (s <- Tab1eBounds[exptype].size); 

expLimit «- LOOPHOLE[s, EXPIndex]; 

sgOffset «- d; d <- d + (s «- TableBounds[sgtype].size) ; 

sgLimit <- LOOPHOLE[s, SGIndex]; 

ftOffset «- d; d «- d + (s <- TableBounds[f ttype].size) ; 

ftLimit <- LOOPHOLE[s, FTIndex]; 

ntOffset «- d; d <- d + (s «- TableBounds[nttype] .size) ; 

ntLimit <- LOOPHOLE[s, NTIndex]; 

nPages <- (d+Al toDef s.PageSize-l)/AltoDefs.PageSize; 
END; 

savenextpage «- nextBcdPage «- header. nPages+1; 
IF data.copycode THEN MoveCodeSegments[]; 
IF data.copysymbols THEN MoveSymbolSegments[]; 
IF packing THEN FixAl lSgis[]; 
bcdStream. reset [bcdStream]; 
WriteBcdWords[header, SIZE[BCD]]; - 
WriteSubTable[sstype]; 
WriteSubTab1e[cttype]; 
WriteSubTable[mttype]; 
WriteSubTable[imptype]; 
WriteSubTable[exptype]; 
WriteSubTable[sgtype]; 
WriteSubTab1e[fttype]; 
WriteSubTable[nttype]; 
IF nextBcdPage # savenextpage THEN 

StreamDef s. Set I ndex[ bcdStream, [page: nextBcdPage-1, byte:0]]; 
CloseOutputFile[]; 
IF -data. errors THEN 

BEGIN OPEN IODefs, header; 

WriteDecimal[nConf igs]; WriteString[" configs, "L]; 

WriteDecimal[nModules]; WriteString[" modules, "L]; 

WriteDecimal[nImports]; WriteString[" imports, "L]; 

WriteDecimal[nExports] ; WriteString[" exports, M L]; 

WriteDecimal[nPages]; WriteString[" pages, ,f L]; 

WriteDecimal[BcdUtilDefs.TimeSince[ data. start time]]; WriteLine[" seconds M L]; 

END; 
RETURN 
END; 

OpenOutputFile: PROCEDURE - 

BEGIN OPEN StreamDefs, SegmentDefs; 
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file: FileHandle <- NIL; 

file «• BcdFi1eDefs.Hand1eForFi1e[data.outputft1 

I BcdFileDefs.UnknownFile ■> CONTINUE]; 
IF file ■ NIL THEN 

file <- NewFile[data.outputf He, Write+Append, DefaultVersion]; 
bcdStream <- CreateWordStream[f ile, Write+Append]; 
RETURN 
END; 

CloseOutputFile: PROCEDURE ■ 
BEGIN 

bcdStream. destroy [bcdStream]; 
bcdStream «- NIL; 
RETURN 
END; 



END.., 



